home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 21
/
Cream of the Crop 21 (Terry Blount) (October 1996).iso
/
os2
/
freetype.zip
/
debugger.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-08-19
|
4KB
|
190 lines
program Debugger;
uses Drivers, Objects, Views, Menus, App, MsgBox, TTIns, CodeTv, StackTv,
Crt, TTTypes, TTError, TTTables, TTFile, TTDebug;
{$I DEBUGGER.INC}
type
TMyApp = object( TApplication )
constructor Init;
procedure NewWindow; virtual;
procedure InitMenuBar; virtual;
procedure HandleEvent( var Event : TEvent ); virtual;
end;
var
CW : PCodeWindow;
SW : PStackWindow;
Code_Range : array[1..3] of PCodeRange;
procedure Initialize;
var
i : int;
begin
for i := 1 to 3 do Code_Range[i] := Get_CodeRange(1);
end;
procedure TMyApp.NewWindow;
var
R : TRect;
RR : TRangeRec;
begin
Desktop^.GetExtent(R);
R.B.X := 32;
New( CW, Init( R ) );
Desktop^.Insert(CW);
Generate_Range( Code_Range[1], RR );
CW^.CodeView^.Set_Range( RR );
Desktop^.GetExtent(R);
R.A.X := 32;
R.B.X := 48;
New( SW, Init( R, Stack, StackSize ) );
Desktop^.Insert(SW);
end;
procedure TMyApp.InitMenuBar;
var
R : TRect;
begin
GetExtent(R);
R.B.Y := R.A.Y + 1;
MenuBar := New( PMenuBar, Init( R, NewMenu(
NewSubMenu('~F~ichier', hcNoContext, NewMenu(
NewItem('~O~uvrir','F3', kbF3, cmFileOpen,hcNoCOntext,
nil )),
nil )
)));
end;
procedure TMyApp.HandleEvent( var Event : TEvent );
begin
inherited HandleEvent(Event);
case Event.What of
evCommand : case Event.Command of
cmNewWin : NewWindow;
else
exit;
end;
else
exit;
end;
ClearEvent(Event);
end;
constructor TMyApp.Init;
begin
inherited Init;
NewWindow;
end;
var
MyApp : TMyApp;
Range : Int;
P : PByteArray;
FileName : String;
Font_Buffer : PStorage;
Out_File : Text;
T, I : int;
begin
GetMem( Font_Buffer, 64000 );
InitBuffer( Font_Buffer^, 64000 );
for i:=0 to ParamCount do Writeln(ParamStr(i));
If paramCount<>1 then
begin
Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
Halt(1);
end;
Filename := ParamStr(1);
if Pos('.',FileName)=0 then FileName:=FileName+'.TTF';
if not Open_TrueType_File( Filename ) then
begin
Writeln('Erreur, le fichier ',ParamStr(1),' n''a pu être ouvert');
Halt(1);
end;
Load_TrueType_Tables;
if not Load_TrueType_MaxProfile then
begin
Writeln('Erreur, la table ''maxp'' est introuvable');
Halt(1);
end;
if not Load_TrueType_CVT then
begin
Writeln('Erreur, la table ''cvt '' est introuvable');
Halt(1);
end;
if not Load_TrueType_Header then
begin
Writeln('Erreur, l''en-tête est introuvable');
Halt(1);
end;
SetScale( 14, 96, Font_Header^.UnitsPerEM );
if not Init_Interpreter( MaxProfile ) then
begin
Writeln('Erreur, initialisation interpréteur');
Halt(1);
end;
T := LookUp_TrueType_Table('fpgm');
if T < 0 then
begin
Writeln('FONT table not found');
halt(1);
end;
Assign( Out_File,'' );
Rewrite( Out_File );
Writeln( Out_File,'Font Program Offset :', Table_Dir_Entries^[T].Offset );
Writeln( Out_File,'Font Program Size :', Table_Dir_Entries^[T].Length );
CodeSize := Table_Dir_Entries^[T].Length;
P := Alloc_CodeRange( Codesize, Range );
if P = nil then
begin
writeln('Erreur, impossible d''allouer le font program' );
halt(1);
end;
writeln( Out_File,'------- FONT -------');
Read_At_Font_File( Table_Dir_Entries^[T].Offset,
P^, CodeSize );
Initialize;
MyApp.Init;
MyApp.Run;
MyApp.Done;
end.